HOMEWORK 2
Ceyhun Onur
01/11/2019
Task 1
Part 1
library(data.table)
library(factoextra)musk <- fread("/home/ceyonur/git/CMPE/fall19-ceyonur/data/homework2/Musk1.csv")
# rename first two columns
names(musk)[1:2]<-c("bag_class", "bag_id")
musksummary_musk_table <- data.frame(unclass(summary(musk)), check.names = FALSE, stringsAsFactors = FALSE)
summary_musk_tablePCA
# remove first two columns (bag class and bag id)
raw_musk <- musk[,c(-1,-2)]
pca_musk <- prcomp(raw_musk)
fviz_eig(pca_musk, addlabels = TRUE)
summary(pca_musk)## Importance of components:
## PC1 PC2 PC3 PC4 PC5
## Standard deviation 673.2307 380.4653 278.94556 249.67115 221.53567
## Proportion of Variance 0.4065 0.1298 0.06979 0.05591 0.04402
## Cumulative Proportion 0.4065 0.5363 0.60611 0.66201 0.70603
## PC6 PC7 PC8 PC9 PC10
## Standard deviation 216.1523 175.15185 153.65192 134.8082 131.31809
## Proportion of Variance 0.0419 0.02751 0.02117 0.0163 0.01547
## Cumulative Proportion 0.7479 0.77545 0.79662 0.8129 0.82839
## PC11 PC12 PC13 PC14 PC15
## Standard deviation 119.07346 113.50449 110.87235 99.36725 95.5925
## Proportion of Variance 0.01272 0.01155 0.01102 0.00886 0.0082
## Cumulative Proportion 0.84110 0.85266 0.86368 0.87254 0.8807
## PC16 PC17 PC18 PC19 PC20
## Standard deviation 92.52041 87.16590 84.32162 82.4879 79.43184
## Proportion of Variance 0.00768 0.00681 0.00638 0.0061 0.00566
## Cumulative Proportion 0.88841 0.89522 0.90160 0.9077 0.91336
## PC21 PC22 PC23 PC24 PC25
## Standard deviation 76.80216 73.81026 72.29108 69.33194 65.36666
## Proportion of Variance 0.00529 0.00489 0.00469 0.00431 0.00383
## Cumulative Proportion 0.91865 0.92354 0.92823 0.93254 0.93637
## PC26 PC27 PC28 PC29 PC30
## Standard deviation 64.03125 61.6150 60.44529 58.53056 55.96865
## Proportion of Variance 0.00368 0.0034 0.00328 0.00307 0.00281
## Cumulative Proportion 0.94005 0.9435 0.94673 0.94980 0.95261
## PC31 PC32 PC33 PC34 PC35
## Standard deviation 54.31483 51.88019 49.80327 49.26944 48.3597
## Proportion of Variance 0.00265 0.00241 0.00222 0.00218 0.0021
## Cumulative Proportion 0.95526 0.95767 0.95989 0.96207 0.9642
## PC36 PC37 PC38 PC39 PC40 PC41
## Standard deviation 45.95658 44.7563 42.88435 41.79055 40.22553 39.4985
## Proportion of Variance 0.00189 0.0018 0.00165 0.00157 0.00145 0.0014
## Cumulative Proportion 0.96606 0.9679 0.96951 0.97107 0.97253 0.9739
## PC42 PC43 PC44 PC45 PC46
## Standard deviation 37.83523 37.09406 36.08196 34.37303 33.76904
## Proportion of Variance 0.00128 0.00123 0.00117 0.00106 0.00102
## Cumulative Proportion 0.97521 0.97644 0.97761 0.97867 0.97969
## PC47 PC48 PC49 PC50 PC51
## Standard deviation 32.67552 31.52300 31.30740 30.29428 29.47740
## Proportion of Variance 0.00096 0.00089 0.00088 0.00082 0.00078
## Cumulative Proportion 0.98065 0.98154 0.98242 0.98324 0.98402
## PC52 PC53 PC54 PC55 PC56
## Standard deviation 28.53048 28.14450 27.68169 27.33083 26.94086
## Proportion of Variance 0.00073 0.00071 0.00069 0.00067 0.00065
## Cumulative Proportion 0.98475 0.98546 0.98615 0.98682 0.98747
## PC57 PC58 PC59 PC60 PC61
## Standard deviation 25.74005 25.21935 23.82684 23.29859 23.15820
## Proportion of Variance 0.00059 0.00057 0.00051 0.00049 0.00048
## Cumulative Proportion 0.98807 0.98864 0.98915 0.98963 0.99011
## PC62 PC63 PC64 PC65 PC66
## Standard deviation 22.55993 22.20886 21.85598 21.31762 20.55301
## Proportion of Variance 0.00046 0.00044 0.00043 0.00041 0.00038
## Cumulative Proportion 0.99057 0.99101 0.99144 0.99185 0.99223
## PC67 PC68 PC69 PC70 PC71
## Standard deviation 20.29024 19.64887 19.24901 18.85577 18.4205
## Proportion of Variance 0.00037 0.00035 0.00033 0.00032 0.0003
## Cumulative Proportion 0.99260 0.99294 0.99328 0.99359 0.9939
## PC72 PC73 PC74 PC75 PC76
## Standard deviation 17.63659 17.54612 16.95395 16.75000 16.49247
## Proportion of Variance 0.00028 0.00028 0.00026 0.00025 0.00024
## Cumulative Proportion 0.99418 0.99445 0.99471 0.99496 0.99521
## PC77 PC78 PC79 PC80 PC81
## Standard deviation 15.85282 15.54531 15.27025 14.7901 14.65919
## Proportion of Variance 0.00023 0.00022 0.00021 0.0002 0.00019
## Cumulative Proportion 0.99543 0.99565 0.99586 0.9960 0.99625
## PC82 PC83 PC84 PC85 PC86
## Standard deviation 14.06402 13.67653 13.41860 13.16473 12.90247
## Proportion of Variance 0.00018 0.00017 0.00016 0.00016 0.00015
## Cumulative Proportion 0.99642 0.99659 0.99675 0.99691 0.99706
## PC87 PC88 PC89 PC90 PC91
## Standard deviation 12.34135 11.89893 11.76484 11.52159 11.27099
## Proportion of Variance 0.00014 0.00013 0.00012 0.00012 0.00011
## Cumulative Proportion 0.99719 0.99732 0.99745 0.99757 0.99768
## PC92 PC93 PC94 PC95 PC96 PC97
## Standard deviation 10.90049 10.7475 10.6927 10.3375 10.14542 10.12016
## Proportion of Variance 0.00011 0.0001 0.0001 0.0001 0.00009 0.00009
## Cumulative Proportion 0.99779 0.9979 0.9980 0.9981 0.99818 0.99827
## PC98 PC99 PC100 PC101 PC102 PC103
## Standard deviation 9.72447 9.45862 9.39353 9.13473 8.98237 8.90538
## Proportion of Variance 0.00008 0.00008 0.00008 0.00007 0.00007 0.00007
## Cumulative Proportion 0.99836 0.99844 0.99852 0.99859 0.99866 0.99873
## PC104 PC105 PC106 PC107 PC108 PC109
## Standard deviation 8.64455 8.26822 8.00874 7.91798 7.79931 7.59897
## Proportion of Variance 0.00007 0.00006 0.00006 0.00006 0.00005 0.00005
## Cumulative Proportion 0.99880 0.99886 0.99892 0.99898 0.99903 0.99908
## PC110 PC111 PC112 PC113 PC114 PC115
## Standard deviation 7.46120 7.19393 7.05771 6.98377 6.82384 6.58582
## Proportion of Variance 0.00005 0.00005 0.00004 0.00004 0.00004 0.00004
## Cumulative Proportion 0.99913 0.99918 0.99922 0.99927 0.99931 0.99935
## PC116 PC117 PC118 PC119 PC120 PC121
## Standard deviation 6.53568 6.28332 6.12328 5.88890 5.85458 5.62307
## Proportion of Variance 0.00004 0.00004 0.00003 0.00003 0.00003 0.00003
## Cumulative Proportion 0.99939 0.99942 0.99946 0.99949 0.99952 0.99955
## PC122 PC123 PC124 PC125 PC126 PC127
## Standard deviation 5.54017 5.42273 5.22421 5.11616 4.98581 4.90223
## Proportion of Variance 0.00003 0.00003 0.00002 0.00002 0.00002 0.00002
## Cumulative Proportion 0.99957 0.99960 0.99962 0.99965 0.99967 0.99969
## PC128 PC129 PC130 PC131 PC132 PC133
## Standard deviation 4.68316 4.65979 4.57225 4.34966 4.20285 4.12357
## Proportion of Variance 0.00002 0.00002 0.00002 0.00002 0.00002 0.00002
## Cumulative Proportion 0.99971 0.99973 0.99975 0.99977 0.99978 0.99980
## PC134 PC135 PC136 PC137 PC138 PC139
## Standard deviation 3.87673 3.81462 3.73832 3.66829 3.53225 3.36524
## Proportion of Variance 0.00001 0.00001 0.00001 0.00001 0.00001 0.00001
## Cumulative Proportion 0.99981 0.99982 0.99984 0.99985 0.99986 0.99987
## PC140 PC141 PC142 PC143 PC144 PC145
## Standard deviation 3.33477 3.31383 3.22377 3.18757 2.94172 2.85440
## Proportion of Variance 0.00001 0.00001 0.00001 0.00001 0.00001 0.00001
## Cumulative Proportion 0.99988 0.99989 0.99990 0.99991 0.99992 0.99992
## PC146 PC147 PC148 PC149 PC150 PC151 PC152
## Standard deviation 2.77978 2.67264 2.66809 2.52881 2.43990 2.301 2.245
## Proportion of Variance 0.00001 0.00001 0.00001 0.00001 0.00001 0.000 0.000
## Cumulative Proportion 0.99993 0.99994 0.99994 0.99995 0.99995 1.000 1.000
## PC153 PC154 PC155 PC156 PC157 PC158 PC159 PC160
## Standard deviation 2.217 2.157 2.13 1.985 1.908 1.774 1.769 1.595
## Proportion of Variance 0.000 0.000 0.00 0.000 0.000 0.000 0.000 0.000
## Cumulative Proportion 1.000 1.000 1.00 1.000 1.000 1.000 1.000 1.000
## PC161 PC162 PC163 PC164 PC165 PC166
## Standard deviation 1.515 1.433 1.389 1.333 1.185 1.047
## Proportion of Variance 0.000 0.000 0.000 0.000 0.000 0.000
## Cumulative Proportion 1.000 1.000 1.000 1.000 1.000 1.000fviz_pca_ind(pca_musk, habillage = musk$bag_class, palette = c("red", "black"), addEllipses = TRUE)
It seems like PCA values are overlapping. So we cannot derive any “useful” grouping information from here.
MDS
eu_matrix <- dist(raw_musk, method="euclidean")
eu_matrix[is.na(eu_matrix)] <- 0
man_matrix <- dist(raw_musk, method="manhattan")
man_matrix[is.na(man_matrix)] <- 0mds_eu <- cmdscale(eu_matrix)
plot(mds_eu[,1],mds_eu[,2],main='MDS Euclidean',xlab='', ylab='',col=musk$bag_class + 1)
mds_man <- cmdscale(man_matrix)
plot(mds_man[,1],mds_man[,2],main='MDS Manhattan',xlab='', ylab='',col=musk$bag_class + 1 )
MDS results are also similar to PCA results, both of them does not seperate the results. They both are overlapping.
Part 2 - Summarizing data
reduced_musk <- musk[,lapply(.SD, mean), by=bag_id]
reduced_muskPCA
raw_reduced_musk <- reduced_musk[,c(-1,-2)]
pca_reduced_musk <- prcomp(raw_reduced_musk)
fviz_eig(pca_reduced_musk, addlabels = TRUE)
summary(pca_reduced_musk)## Importance of components:
## PC1 PC2 PC3 PC4 PC5
## Standard deviation 476.3579 388.1726 315.2941 267.5711 208.89465
## Proportion of Variance 0.3234 0.2147 0.1417 0.1020 0.06219
## Cumulative Proportion 0.3234 0.5381 0.6798 0.7818 0.84398
## PC6 PC7 PC8 PC9 PC10
## Standard deviation 141.74494 132.93747 101.99365 97.35006 79.29611
## Proportion of Variance 0.02863 0.02518 0.01482 0.01351 0.00896
## Cumulative Proportion 0.87261 0.89780 0.91262 0.92613 0.93509
## PC11 PC12 PC13 PC14 PC15
## Standard deviation 78.38832 60.55659 56.71926 53.26428 51.49747
## Proportion of Variance 0.00876 0.00523 0.00458 0.00404 0.00378
## Cumulative Proportion 0.94385 0.94907 0.95366 0.95770 0.96148
## PC16 PC17 PC18 PC19 PC20
## Standard deviation 50.87371 45.72380 43.80707 41.68229 39.3103
## Proportion of Variance 0.00369 0.00298 0.00273 0.00248 0.0022
## Cumulative Proportion 0.96517 0.96815 0.97088 0.97336 0.9756
## PC21 PC22 PC23 PC24 PC25
## Standard deviation 37.81009 35.89883 35.17215 32.4388 31.04885
## Proportion of Variance 0.00204 0.00184 0.00176 0.0015 0.00137
## Cumulative Proportion 0.97760 0.97943 0.98120 0.9827 0.98407
## PC26 PC27 PC28 PC29 PC30
## Standard deviation 30.34175 28.63002 28.38996 27.48433 25.91255
## Proportion of Variance 0.00131 0.00117 0.00115 0.00108 0.00096
## Cumulative Proportion 0.98538 0.98655 0.98770 0.98877 0.98973
## PC31 PC32 PC33 PC34 PC35
## Standard deviation 23.79250 22.92050 22.30824 21.14816 19.96334
## Proportion of Variance 0.00081 0.00075 0.00071 0.00064 0.00057
## Cumulative Proportion 0.99054 0.99129 0.99200 0.99263 0.99320
## PC36 PC37 PC38 PC39 PC40
## Standard deviation 19.33840 19.04780 17.67689 17.48164 16.36011
## Proportion of Variance 0.00053 0.00052 0.00045 0.00044 0.00038
## Cumulative Proportion 0.99373 0.99425 0.99470 0.99513 0.99551
## PC41 PC42 PC43 PC44 PC45
## Standard deviation 16.22484 15.79285 15.33384 14.08078 13.52853
## Proportion of Variance 0.00038 0.00036 0.00034 0.00028 0.00026
## Cumulative Proportion 0.99589 0.99624 0.99658 0.99686 0.99712
## PC46 PC47 PC48 PC49 PC50
## Standard deviation 13.11548 12.70848 11.7922 11.50181 11.23206
## Proportion of Variance 0.00025 0.00023 0.0002 0.00019 0.00018
## Cumulative Proportion 0.99737 0.99760 0.9978 0.99798 0.99816
## PC51 PC52 PC53 PC54 PC55 PC56
## Standard deviation 11.07515 10.35902 9.88946 9.57266 9.37468 8.5071
## Proportion of Variance 0.00017 0.00015 0.00014 0.00013 0.00013 0.0001
## Cumulative Proportion 0.99834 0.99849 0.99863 0.99876 0.99889 0.9990
## PC57 PC58 PC59 PC60 PC61 PC62
## Standard deviation 8.2948 8.14618 7.46566 7.09137 6.99465 6.56272
## Proportion of Variance 0.0001 0.00009 0.00008 0.00007 0.00007 0.00006
## Cumulative Proportion 0.9991 0.99918 0.99926 0.99933 0.99940 0.99946
## PC63 PC64 PC65 PC66 PC67 PC68
## Standard deviation 6.10271 5.83357 5.58179 5.42840 5.21849 4.78298
## Proportion of Variance 0.00005 0.00005 0.00004 0.00004 0.00004 0.00003
## Cumulative Proportion 0.99952 0.99957 0.99961 0.99965 0.99969 0.99972
## PC69 PC70 PC71 PC72 PC73 PC74
## Standard deviation 4.55134 4.52345 4.34936 4.00934 3.77207 3.72783
## Proportion of Variance 0.00003 0.00003 0.00003 0.00002 0.00002 0.00002
## Cumulative Proportion 0.99975 0.99978 0.99981 0.99983 0.99985 0.99987
## PC75 PC76 PC77 PC78 PC79 PC80
## Standard deviation 3.39958 3.32214 3.06324 2.91531 2.69905 2.52245
## Proportion of Variance 0.00002 0.00002 0.00001 0.00001 0.00001 0.00001
## Cumulative Proportion 0.99989 0.99991 0.99992 0.99993 0.99994 0.99995
## PC81 PC82 PC83 PC84 PC85 PC86 PC87
## Standard deviation 2.47205 2.19289 2.10483 2.08237 1.90233 1.689 1.556
## Proportion of Variance 0.00001 0.00001 0.00001 0.00001 0.00001 0.000 0.000
## Cumulative Proportion 0.99996 0.99997 0.99997 0.99998 0.99998 1.000 1.000
## PC88 PC89 PC90 PC91 PC92
## Standard deviation 1.451 1.402 1.175 1.035 3.666e-14
## Proportion of Variance 0.000 0.000 0.000 0.000 0.000e+00
## Cumulative Proportion 1.000 1.000 1.000 1.000 1.000e+00fviz_pca_ind(pca_reduced_musk, habillage = reduced_musk$bag_class, palette = c("red", "black"),addEllipses = TRUE)
When compared to the first PCA plot, this one is less overlapping, the group 0 has a much seperate group. However it’s still overlapping a lot. So even with the grouped results, we cannot say PCA clearly tells us how to group values.
MDS
eu_matrix_r <- dist(reduced_musk, method="euclidean")
eu_matrix_r[is.na(eu_matrix_r)] <- 0
man_matrix_r <- dist(reduced_musk, method="manhattan")
man_matrix_r[is.na(man_matrix_r)] <- 0
mds_eu_r <- cmdscale(eu_matrix_r)
plot(mds_eu_r[,1],mds_eu_r[,2],main='MDS Euclidean',xlab='', ylab='',col=reduced_musk$bag_class + 1)
mds_man_r=cmdscale(man_matrix_r)
plot(mds_man_r[,1],mds_man_r[,2],main='MDS Manhattan',xlab='', ylab='',col=reduced_musk$bag_class + 1 )
MDS plots also cannot tell us more when they’re grouped.
Task 2
Part 1 - Read and Show the Image
library(jpeg)lake <- readJPEG("/home/ceyonur/git/CMPE/fall19-ceyonur/data/homework2/IMG-20190421-WA0028.jpg")
# dimensions of the JPEG
dim(lake)## [1] 256 256 3plot(0:256, 0:256, xlab= "x",ylab="y", main="lake", frame.plot = TRUE, axes= FALSE, type="n")
xticks <-seq(0,256,256/4)
yticks <-seq(0,256,256/4)
axy<-axis(2, at = yticks, labels = yticks)
axx<-axis(1, at = xticks, labels = xticks)
rasterImage(lake, 0, 0, 256, 256,interpolate=FALSE)
Part 2 - Noisy Image
Subpart a - Show Image
reds <- lake[,,1]
greens <- lake[,,2]
blues <- lake[,,3]
rednoise <- matrix(runif(256*256, min(reds),max(reds)*0.1), 256,256)
greennoise <- matrix(runif(256*256, min(greens),max(greens)*0.1), 256,256)
bluenoise <- matrix(runif(256*256, min(blues),max(blues)*0.1), 256,256)
noisy_lake <- lake
noisy_lake[,,1] <- reds + rednoise
noisy_lake[,,2] <- greens + greennoise
noisy_lake[,,3] <- blues + bluenoise
noisy_lake<-ifelse(noisy_lake>1,1,noisy_lake)
plot(0:256, 0:256, xlab= "x",ylab="y", main="noisy lake", frame.plot = TRUE, axes= FALSE, type="n")
xticks <-seq(0,256,256/4)
yticks <-seq(0,256,256/4)
axis(2, at = yticks, labels = yticks)
axis(1, at = xticks, labels = xticks)
rasterImage(noisy_lake, 0, 0, 256, 256,interpolate=FALSE)
summary(noisy_lake - lake)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.00000 0.02497 0.04969 0.04965 0.07423 0.10000plot(0:256, 0:256, xlab= "x",ylab="y", main="noise", frame.plot = TRUE, axes= FALSE, type="n")
xticks <-seq(0,256,256/4)
yticks <-seq(0,256,256/4)
axis(2, at = yticks, labels = yticks)
axis(1, at = xticks, labels = xticks)
rasterImage(noisy_lake - lake, 0, 0, 256, 256,interpolate=FALSE)
Subpart b - Color Channels
par(mfrow=c(1,3), oma = c(0, 0, 2, 0))
image(1:256,1:256,t(apply(lake[,,1],2,rev)), xlab="x",ylab="y", main="red channel")
image(1:256,1:256,t(apply(lake[,,2],2,rev)), xlab="x",ylab="y", main="green channel")
image(1:256,1:256,t(apply(lake[,,3],2,rev)), xlab="x",ylab="y", main="blue channel")
mtext("Original RGB Channels", outer = TRUE, cex = 1.5)
par(mfrow=c(1,3), oma = c(0, 0, 2, 0))
image(1:256,1:256,t(apply(noisy_lake[,,1],2,rev)), xlab="x",ylab="y", main="red channel")
image(1:256,1:256,t(apply(noisy_lake[,,2],2,rev)), xlab="x",ylab="y", main="green channel")
image(1:256,1:256,t(apply(noisy_lake[,,3],2,rev)), xlab="x",ylab="y", main="blue channel")
mtext("Noisy RGB Channels", outer = TRUE, cex = 1.5)
par(mfrow=c(1,3), oma = c(0, 0, 2, 0))
lake_red <- lake
lake_red[,,2:3] <- 0
lake_blue <- lake
lake_blue[,,c(1,3)] <- 0
lake_green <- lake
lake_green[,,1:2] <- 0
xticks <-seq(0,256,256/4)
yticks <-seq(0,256,256/4)
plot(0:256, 0:256, xlab = "x",ylab = "y", main = "red channel", frame.plot = TRUE, axes = FALSE, type = "n")
axis(2, at = yticks, labels = yticks)
axis(1, at = xticks, labels = xticks)
rasterImage(lake_red, 0, 0, 256, 256, interpolate = FALSE)
plot(0:256, 0:256, xlab = "x",ylab = "y", main = "blue channel", frame.plot = TRUE, axes = FALSE, type = "n")
axis(2, at = yticks, labels = yticks)
axis(1, at = xticks, labels = xticks)
rasterImage(lake_blue, 0, 0, 256, 256, interpolate = FALSE)
plot(0:256, 0:256, xlab = "x", ylab = "y", main = "green channel", frame.plot = TRUE, axes = FALSE, type = "n")
axis(2, at = yticks, labels = yticks)
axis(1, at = xticks, labels = xticks)
rasterImage(lake_green, 0, 0, 256, 256, interpolate = FALSE)
mtext("Original RGB Channels", outer = TRUE, cex = 1.5)
par(mfrow = c(1,3), oma = c(0, 0, 2, 0))
noisy_lake_red <- noisy_lake
noisy_lake_red[,,2:3] <- 0
noisy_lake_blue <- noisy_lake
noisy_lake_blue[,,c(1,3)] <- 0
noisy_lake_green <- noisy_lake
noisy_lake_green[,,1:2] <- 0
xticks <-seq(0,256,256/4)
yticks <-seq(0,256,256/4)
plot(0:256, 0:256, xlab = "x",ylab = "y", main ="red channel", frame.plot = TRUE, axes= FALSE, type="n")
axis(2, at = yticks, labels = yticks)
axis(1, at = xticks, labels = xticks)
rasterImage(noisy_lake_red, 0, 0, 256, 256,interpolate=FALSE)
plot(0:256, 0:256, xlab= "x",ylab="y", main="blue channel", frame.plot = TRUE, axes= FALSE, type="n")
axis(2, at = yticks, labels = yticks)
axis(1, at = xticks, labels = xticks)
rasterImage(noisy_lake_blue, 0, 0, 256, 256,interpolate=FALSE)
plot(0:256, 0:256, xlab= "x",ylab="y", main="green channel", frame.plot = TRUE, axes= FALSE, type="n")
axis(2, at = yticks, labels = yticks)
axis(1, at = xticks, labels = xticks)
rasterImage(noisy_lake_green, 0, 0, 256, 256,interpolate=FALSE)
mtext("Noisy RGB Channels", outer = TRUE, cex = 1.5)
par(mfrow=c(1,2))
plot(lake[,,1], col="red", main = "Original", xlab="", ylab="")
points(lake[,,2], col="green")
points(lake[,,3], col="blue")
plot(noisy_lake[,,1], col="red", main = "Noisy", xlab="", ylab="")
points(noisy_lake[,,2], col="green")
points(noisy_lake[,,3], col="blue")
mtext("Color Intensities", outer = TRUE, cex = 1.5)
Part 3 - PCA
gray_noisy_lake<- noisy_lake[,,1] + noisy_lake[,,2] + noisy_lake[,,3]
# normalize
gray_noisy_lake <- gray_noisy_lake/max(gray_noisy_lake)
plot(0:256, 0:256, xlab= "x",ylab="y", main="gray noisy lake", frame.plot = TRUE, axes= FALSE, type="n")
xticks <-seq(0,256,256/4)
yticks <-seq(0,256,256/4)
axy<-axis(2, at = yticks, labels = yticks)
axx<-axis(1, at = xticks, labels = xticks)
rasterImage(gray_noisy_lake, 0, 0, 256, 256,interpolate = FALSE)
patch_size <- 3
from <- floor(patch_size/2) + 1
to <- dim(gray_noisy_lake)[1] - from + 1
patches <- matrix(0,nrow = length(from:to)^2,ncol=patch_size^2, byrow=TRUE)
margin <- floor(patch_size/2)
counter <- 1
for(y in from:to){
for(x in from:to){
patch <- gray_noisy_lake[(x - margin):(x + margin),(y - margin):(y + margin) ]
patches[counter, ] <- as.vector(patch)
counter <- counter + 1
}
}
gray_noisy_lake_pca<-prcomp(patches)
plot(gray_noisy_lake_pca)
summary(gray_noisy_lake_pca)## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6
## Standard deviation 0.7493 0.13316 0.10740 0.09298 0.07358 0.06868
## Proportion of Variance 0.9052 0.02859 0.01859 0.01394 0.00873 0.00760
## Cumulative Proportion 0.9052 0.93380 0.95239 0.96633 0.97506 0.98266
## PC7 PC8 PC9
## Standard deviation 0.06638 0.05757 0.05508
## Proportion of Variance 0.00710 0.00534 0.00489
## Cumulative Proportion 0.98977 0.99511 1.00000scores <- gray_noisy_lake_pca$x
comp1_matrix <- matrix(scores[,1], nrow = 254, ncol = 254 , byrow = TRUE)
plot(c(0, 254), c(0, 254), type = "n", xlab = "", ylab = "",main = "Comp.1 Image")
normalize <- function(x) {
return ((x - min(x)) / (max(x) - min(x)))
}
comp1_matrix <- t(comp1_matrix)
rasterImage(normalize(comp1_matrix),0,0,254,254)
comp2_matrix <- matrix(scores[,2], nrow = 254, ncol = 254 , byrow = TRUE)
plot(c(0, 254), c(0, 254), type = "n", xlab = "", ylab = "",main = "Comp.2 Image")
comp2_matrix <- t(comp2_matrix)
rasterImage(normalize(comp2_matrix),0,0,254,254)
comp3_matrix <- matrix(scores[,3], nrow = 254, ncol = 254 , byrow = TRUE)
plot(c(0, 254), c(0, 254), type = "n", xlab = "", ylab = "",main = "Comp.3 Image")
comp3_matrix <- t(comp3_matrix)
rasterImage(normalize(comp3_matrix),0,0,254,254)
eigenVectors <- gray_noisy_lake_pca$rotation[,1:3]
eigenVectors## PC1 PC2 PC3
## [1,] -0.3307586 -3.661379e-01 0.424475565
## [2,] -0.3336646 -4.362117e-01 0.034824542
## [3,] -0.3306230 -4.174437e-01 -0.360054796
## [4,] -0.3345913 4.651654e-02 0.434869891
## [5,] -0.3381951 -1.903773e-05 0.001280525
## [6,] -0.3353142 -4.653665e-02 -0.433609514
## [7,] -0.3304692 4.168630e-01 0.360379277
## [8,] -0.3342451 4.354742e-01 -0.034166409
## [9,] -0.3320581 3.655970e-01 -0.425202364comp1_eigens <- matrix(eigenVectors[,1], nrow = patch_size, ncol = patch_size , byrow = TRUE)
plot(c(0, patch_size), c(0, patch_size), type = "n", xlab = "", ylab = "",main = "Eigen Comp.1 Image")
comp1_eigens <- t(comp1_eigens)
rasterImage(normalize(comp1_eigens),0,0,patch_size,patch_size, interpolate = FALSE)
comp2_eigens <- matrix(eigenVectors[,2], nrow = patch_size, ncol = patch_size , byrow = TRUE)
plot(c(0, patch_size), c(0, patch_size), type = "n", xlab = "", ylab = "",main = "Eigen Comp.2 Image")
comp2_eigens <- t(comp2_eigens)
rasterImage(normalize(comp2_eigens),0,0,patch_size,patch_size, interpolate = FALSE)
comp3_eigens <- matrix(eigenVectors[,3], nrow = patch_size, ncol = patch_size , byrow = TRUE)
plot(c(0, patch_size), c(0, patch_size), type = "n", xlab = "", ylab = "",main = "Eigen Comp.3 Image")
comp3_eigens <- t(comp3_eigens)
rasterImage(normalize(comp3_eigens),0,0,patch_size,patch_size, interpolate = FALSE)